home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / montecarlo.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  95 lines
  1. /**********************************\
  2. ** MonteCarlo v1.0 for Solitarexx **
  3. **      by Michal Szafranski      **
  4. \**********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Monte Carlo v1.0"'
  8. order.0 = '0 5 10 15 1 6 11 16 2 7 12 17 3 8 13 18 4 9 14 19 20'
  9. order.1 = '0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20'
  10. order.2 = '19 18 17 16 15 10 11 12 13 14 9 8 7 6 5 0 1 2 3 4 20'
  11. order.3 = '13 12 11 6 7 8 9 14 19 18 17 16 15 10 5 0 1 2 3 4 20'
  12. ADDBUTTON 0 10 "Start"
  13. ADDCYCLE 1 12 'Vert|Horiz|Snake|Spiral' 1
  14. ADDTEXT 4 30 tex 6
  15. ADDBUTTON 12 10 "Abort"
  16. ADDTEXT 13 12 '""' 6
  17. ADDTEXT 14 30 tex 6
  18. SELECTGUI 1
  19. SCREENSIZE 4 0 6 0
  20. DO i = 0 TO 19
  21.     NEWSTACK i 0 0 (i//5) (i%5)
  22.     stack.i = RESULT
  23. END
  24. NEWSTACK 20 0 1 5 0
  25. stack.20 = RESULT
  26. NEWSTACK 21 0 1 5 3
  27. waste = RESULT
  28. ADDCARDS stack.20 SHUFFLED
  29.  
  30. DO FOREVER
  31.     ACTION
  32.     PARSE VAR RESULT act rest
  33.     IF act = 1 THEN EXIT
  34.     IF act = 3 THEN CALL GAME
  35. END
  36.  
  37. GAME:
  38.     CLEANUP stack.20
  39.     SELECTGUI 4
  40.     sel = 20
  41.     fin = 52
  42.     SETGADGET 13 STR '"Left: 52"'
  43.     GETGADGET 1
  44.     order = order.RESULT
  45.     CALL DODECK
  46.     DO FOREVER
  47.         ACTION
  48.         PARSE VAR RESULT act stack sid card
  49.         IF act = 1 THEN EXIT
  50.         IF act = 2 THEN SELECT
  51.             WHEN sid = 20 THEN CALL DODECK
  52.             WHEN sid < 20 & sel = 20 & card>0 THEN sel=sid
  53.             WHEN sid < 20 & sel < 20 & card>0 THEN CALL DOSTACKS
  54.             OTHERWISE ERRBEEP
  55.         END
  56.         IF act = 3 THEN DO
  57.             SELECTGUI 1
  58.             RETURN
  59.         END
  60.     END
  61. RETURN
  62. DODECK:
  63.     sel = 20
  64.     sfrom = 1
  65.     DO sto = 1 TO 20
  66.         asto = WORD(order,sto)
  67.         DO FOREVER
  68.             asfrom = WORD(order,sfrom)
  69.             CARDSELECT stack.asfrom 1
  70.             IF RESULT = '' THEN sfrom = sfrom +1
  71.             ELSE LEAVE
  72.             IF sfrom = 22 THEN RETURN
  73.         END
  74.         IF sfrom = 21 THEN mode = 'REVERSE'
  75.         ELSE mode = ''
  76.         IF asfrom = asto THEN sfrom = sfrom +1
  77.         ELSE MOVECARDS stack.asfrom stack.asto mode
  78.     END
  79. RETURN
  80. DOSTACKS:
  81.     CARDSELECT stack.sel 1
  82.     PARSE VAR RESULT . w1 .
  83.     CARDSELECT stack 1
  84.     PARSE VAR RESULT . w2 .
  85.     IF w1 = w2 & ABS((sel//5)-(sid//5))<2 & 2>ABS((sel%5)-(sid%5)) & sel~=sid THEN DO
  86.         MOVECARDS stack.sel waste
  87.         MOVECARDS stack waste
  88.         fin = fin - 2
  89.         IF fin = 0 THEN SETGADGET 13 STR '"Winner"'
  90.         ELSE SETGADGET 13 STR '"Left:' fin||'"'
  91.     END
  92.     ELSE ERRBEEP
  93.     sel = 20
  94. RETURN
  95.